home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1991: Code Warrior / bincue / Code Warrior.bin / Development Platforms (Moof!) / LISP Related / Goal-Plan-Code Editor / library / make.lisp < prev    next >
Encoding:
Text File  |  1990-07-06  |  7.7 KB  |  152 lines  |  [TEXT/CCL ]
  1. ;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
  2. ;@@@ Make
  3. ;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
  4. ;
  5. ; These functions do a brain-damaged make: They don't ensure that required
  6. ; modules have been made, ie are up-to-date.
  7.  
  8.  
  9. ; check-make
  10. ;
  11. ; check-make takes a path (either a pathname (lisp or mac) or a string)
  12. ; and looks for a pair of files with paths identical to the argument,
  13. ; but with "lisp" and "fasl" as the types.  If it finds them, it then
  14. ; compares their latest write dates: if the fasl is younger than the lisp,
  15. ; then return the mac-filename of the fasl and the lisp-filename of the lisp;
  16. ; but if the fasl is older than the lisp, then return the lisp-filename of both.
  17. ; If check-make can't find the lisp, then it returns the fasl's lisp-filename
  18. ; and nil.  If it can't find the fals, then it returns the fasl's lisp-filename
  19. ; and the lisp's lisp-filename.
  20. ;
  21. ; In sum, two values are returned, whose types determine the appropriate
  22. ; action by make:
  23. ;
  24. ; The first is the fasl's filename: if a lisp pathname, then need to compile;
  25. ; if a mac filename, then don't need to compile.
  26. ;
  27. ; The second is the lisp's filename or nil: if nil, then couldn't find the
  28. ; source, can't make; if a lisp pathname, then can use it to make a fasl.
  29. ;
  30. (defun check-make (pn)
  31.   (let* ((pathname (expand-logical-pathname
  32.                     (merge-pathnames pn *working-directory*)))
  33.          (the-lisp-name (make-pathname :host (pathname-host pathname)
  34.                                        :device (pathname-device pathname)
  35.                                        :directory (pathname-directory pathname)
  36.                                        :name (pathname-name pathname)
  37.                                        :type "lisp"))
  38.          (the-lisp-file (probe-file the-lisp-name))
  39.          (the-fasl-name (make-pathname :host (pathname-host pathname)
  40.                                        :device (pathname-device pathname)
  41.                                        :directory (pathname-directory pathname)
  42.                                        :name (pathname-name pathname)
  43.                                        :type "fasl"))
  44.          (the-fasl-file (probe-file the-fasl-name)))
  45.     (if the-lisp-file
  46.       (if the-fasl-file
  47.         (if (> (file-write-date the-fasl-file) (file-write-date the-lisp-file))
  48.           (values the-fasl-file the-lisp-name)
  49.           (values the-fasl-name the-lisp-name))
  50.         (values the-fasl-name the-lisp-name))
  51.       (values the-fasl-name nil))))
  52.  
  53. ; make-file
  54. ;
  55. ; make-file accepts a string, lisp-pathname, or mac-pathname and two optional arguments,
  56. ; check-p and temp-p.  It determines whether the file pointed to by the path needs to
  57. ; be made, using check-make.  If yes, then when check-p is false, or check-p is true
  58. ; and the user responds to a y-or-n-dialog with yes, compile the source.  If temp-p is
  59. ; true send the fasl to the same name and directory as the source, but type "temp-fasl".
  60. ;
  61. ; Return two values:  The first is t if the path has been made (either already ok,
  62. ; or new fasl compiled), or nil if the path needs still to be made.  The second is
  63. ; the path to the source, which is a mac-pathname if a new file was created, a lisp-
  64. ; pathname if a new file was needed, but not created, and nil otherwise.
  65. ;
  66. (defun make-file (pn &optional check-p temp-p)
  67.   (catch :cancel
  68.     (multiple-value-bind (the-fasl the-lisp)
  69.                          (check-make (cond ((stringp pn)
  70.                                             (expand-logical-namestring pn))
  71.                                            ((pathnamep pn)
  72.                                             (expand-logical-pathname pn))
  73.                                            (t (error "The file must be either a string, a mac-pathname,~%~
  74.                                                       or a lisp-pathname, not ~a."
  75.                                                      pn))))
  76.       (if (lisp-pathnamep the-fasl)
  77.         (if (lisp-pathnamep the-lisp)
  78.           (if (or (not check-p)
  79.                   (and check-p (y-or-n-dialog "The file ~a needs to be compiled.~%Do it now?"
  80.                                               (mac-filename (mac-pathname the-fasl)))))
  81.             (if temp-p
  82.               (values t (compile-file the-lisp
  83.                                       :output-file
  84.                                       (make-pathname :host (pathname-host the-fasl)
  85.                                                      :device (pathname-device the-fasl)
  86.                                                      :directory (pathname-directory the-fasl)
  87.                                                      :name (pathname-name the-fasl)
  88.                                                      :type "temp-fasl")))
  89.               (values t (compile-file the-lisp)))
  90.             (values nil the-lisp))
  91.           (values nil nil))
  92.         (values t nil)))))
  93.  
  94. ; make-directory
  95. ;
  96. ; make-directory takes the host, device, and directory components of the entered
  97. ; path (string, lisp, or mac) and applies make-file to each file of type "lisp" in
  98. ; the result.  If make-directories second argument, check-p is non-nil, then make-
  99. ; file will check whether to make any files that need making.  Finally, errors in
  100. ; compilation produce a dialog that asks whether the makes so far should be abandoned,
  101. ; thus returning the directory to its state before the make-directory call.  If the
  102. ; response is yes, then the newly created fasls (all of type "temp-fasl", thanks to
  103. ; passing t as temp-p to make-file) are deleted.  At the end of successfully 
  104. ; making all the files, the created fasls are renamed with type "fasl".
  105. ;
  106. (defun make-directory (&optional (pn *working-directory*) check-p)
  107.   (let* ((the-full-pn (cond ((stringp pn)
  108.                              (expand-logical-namestring pn))
  109.                             ((pathnamep pn)
  110.                              (expand-logical-pathname pn))
  111.                             (t (error "The file must be either a string, a mac-pathname,~%~
  112.                                        or a lisp-pathname, not ~a."
  113.                                       pn))))
  114.          (the-directory
  115.           (merge-pathnames (make-pathname :host (pathname-host the-full-pn)
  116.                                           :device (pathname-device the-full-pn)
  117.                                           :directory (pathname-directory the-full-pn))
  118.                            *working-directory*))
  119.          (the-current-file nil)
  120.          (the-intermediates nil))
  121.     (unwind-protect
  122.       (progn
  123.         (do-files-in-directory (file-name the-directory
  124.                                           (progn
  125.                                             (setf the-current-file nil)
  126.                                             (nreverse the-intermediates)))
  127.           (setf the-current-file (mac-filename (mac-pathname file-name)))
  128.           (when (string= (pathname-type file-name) "lisp")
  129.             (multiple-value-bind (done file)
  130.                                  (make-file file-name check-p t)
  131.               (when (and done file)
  132.                 (push file the-intermediates)))))
  133.         (mapc #'(lambda (f)
  134.                   (rename-file f (make-pathname :type "fasl") :overwrite t))
  135.               the-intermediates))
  136.       (when (and the-current-file
  137.                  (not (catch :cancel
  138.                         (y-or-n-dialog "Compilation failed on file ~a.~%~
  139.                                         Do you wish to keep the successful compilations?"
  140.                                        the-current-file))))
  141.         (mapc #'(lambda (f)
  142.                   (delete-file f :error-if-no-exist nil :overwrite t))
  143.               the-intermediates)))))
  144.  
  145. ; make-require
  146. ;
  147. (defun make-require (m &optional (f m))
  148.   (make-file f)
  149.   (funcall #'require m f))
  150.  
  151. (eval-when (load compile)
  152.   (provide "make"))